home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ML_BME1.ZIP / _LIB_ / BITMAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-14  |  35.8 KB  |  1,220 lines
  1. Unit Bitmap;
  2.  
  3. {
  4.   Bitmap handling routines, v4.12
  5.   by Maple Leaf, 1995-96
  6.   ----------------------------------
  7.   Supported formats:
  8.   Load: BMP,TGA,EST,LBM,PIC,PCX,BIN
  9.   Save: BMP,TGA,EST,LBM,BIN
  10. }
  11.  
  12. Interface
  13.  
  14. Uses alloc, Files, FCache, XMS;
  15.  
  16. Const
  17.   BitMapError : Byte   = 0;
  18.  
  19. { Quick utils }
  20. Procedure ShowPic(PicPtr:Pointer);
  21.  
  22. { XMS-ed bitmaps handling }
  23. Procedure MovePicToXMS(PalPtr:Pointer; var PicPtr:Pointer; var Handle:word);
  24. Procedure CopyPicToXMS(PalPtr,PicPtr:Pointer; var Handle:word);
  25. Procedure CopyPicFromXMS(PalPtr:pointer; var PicPtr:Pointer; var Handle:word);
  26. Procedure MovePicFromXMS(PalPtr:pointer; var PicPtr:Pointer; var Handle:word);
  27.  
  28. { Load }
  29. Function  LoadEST(FileName:String; PalPtr:Pointer) : Pointer;
  30. Function  LoadBMP(FileName:String; PalPtr:Pointer) : Pointer;
  31. Function  LoadTGA(FileName:String; PalPtr:Pointer) : Pointer;
  32. Function  LoadBIN(FileName:String; PalPtr:Pointer) : Pointer;
  33. Function  LoadLBM(FileName:String; PalPtr:Pointer) : Pointer; { only the "PBM " format supported }
  34. Function  LoadPIC(FileName:String; PalPtr:Pointer) : Pointer;
  35. Function  LoadPCX(FileName:String; PalPtr:Pointer) : Pointer;
  36.  
  37. { Overlayed EST loader }
  38. Function  LoadESTFromFile(var f:File; PalPtr:Pointer) : Pointer;
  39.  
  40. { Save }
  41. Procedure SaveEST(FileName:String; PalPtr,PicPtr:Pointer);
  42. Procedure SaveBMP(FileName:String; PalPtr,PicPtr:Pointer);
  43. Procedure SaveTGA(FileName:String; PalPtr,PicPtr:Pointer);
  44. Procedure SaveBIN(FileName:String; PalPtr,PicPtr:Pointer);
  45. Procedure SaveLBM(FileName:String; PalPtr,PicPtr:Pointer); { only the "PBM " format supported }
  46.  
  47. Implementation
  48.  
  49. Procedure ShowPic(PicPtr:Pointer);assembler;
  50. asm
  51.   push ds
  52.   mov cx,16000
  53.   mov di,0a000h
  54.   mov es,di
  55.   xor di,di
  56.   lds si,dword ptr PicPtr
  57.   cld
  58.   db 66h; rep movsw
  59.   pop ds
  60. end;
  61.  
  62. Function  LoadBMP(FileName:String; PalPtr:Pointer) : Pointer;
  63. Var
  64.   f:file; p:pointer;
  65.   z:byte;
  66.   lin,k,col:longint;
  67.   xx,yy,r:word;
  68.   _xx : word;
  69.   bb:byte;
  70. begin {$i-}
  71.   BitMapError:=0; LoadBMP:=nil;
  72.   if not OpenForInput(f,FileName) then begin
  73.     BitMapError:=1;
  74.     Exit;
  75.   end;
  76.   if mavail<64000 then begin
  77.     BitMapError:=2; { Not enough memory }
  78.     CloseFile(f);
  79.     exit;
  80.   end;
  81.   p:=malloc(64000);
  82.   fillchar(p^,64000,0);
  83.   seek(f,$12); BlockRead(f,xx,2,r);
  84.   seek(f,$16); BlockRead(f,yy,2,r);
  85.   _xx:=(FileSize(f)-1077) div yy;
  86.   if yy>200 then yy:=200;
  87.   Seek(f,$36);
  88.   ResetBuffer;
  89.   for k:=0 to 255 do begin
  90.     Mem[seg(PalPtr^):ofs(PalPtr^)+k*3+2]:=ReadByte(f) shr 2;
  91.     Mem[seg(PalPtr^):ofs(PalPtr^)+k*3+1]:=ReadByte(f) shr 2;
  92.     Mem[seg(PalPtr^):ofs(PalPtr^)+k*3+0]:=ReadByte(f) shr 2;
  93.     z:=ReadByte(f);
  94.   end;
  95.   {if not center then begin
  96.     lin:=yy; col:=0;
  97.   end else begin}
  98.     lin:=100+(yy div 2);
  99.     col:=160-(_xx div 2);
  100.   {end;}
  101.   repeat
  102.     dec(lin);
  103.     for k:=0 to _xx-1 do begin
  104.       bb:=ReadByte(f);
  105.       if k+1>xx then
  106.         Mem[seg(p^):ofs(p^)+(lin*320)+k+col]:=0
  107.       else
  108.         Mem[seg(p^):ofs(p^)+(lin*320)+k+col]:=bb;
  109.     end;
  110.   until lin=0;
  111.   CloseFile(f);
  112.   LoadBMP:=p;
  113. end;
  114.  
  115. Procedure SaveBMP(FileName:String; PalPtr,PicPtr:Pointer);
  116. var
  117.   f:file; r:word;
  118.   k : word;
  119.   lulu : word;
  120.   PalBMP : array [0..255] of record b, g, r, z: byte end;
  121.   Offset:word;
  122.   lin:word;
  123. Const
  124.   BMP_Header : Array [0..$35] of byte = ( $42, $4d, $36, $fe, 0, 0, 0, 0, 0, 0, $36, 4, 0, 0, $28, 0, 0, 0,
  125.                $40, 1, 0, 0, $c8, 0, 0, 0, 1, 0, 8, 0, 0, 0, 0, 0, 0, $fa, 0, 0,
  126.                0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
  127. begin {$i-}
  128.   BitMapError:=0;
  129.   if not OpenForOutput(f,FileName) then begin
  130.     BitMapError:=5;
  131.   end;
  132.   BlockWrite(f,BMP_Header,SizeOf(BMP_Header)); { Writing BMP header }
  133.   OutBuffIndex:=0;
  134.   { Writing palette }
  135.   for k:=0 to 255 do begin
  136.     PalBMP[k].r:=mem[seg(PalPtr^):ofs(PalPtr^)+k*3];
  137.     PalBMP[k].g:=mem[seg(PalPtr^):ofs(PalPtr^)+k*3+1];
  138.     PalBMP[k].b:=mem[seg(PalPtr^):ofs(PalPtr^)+k*3+2];
  139.     PalBMP[k].z:=0;
  140.     WriteByte(f,PalBMP[k].b shl 2);
  141.     WriteByte(f,PalBMP[k].g shl 2);
  142.     WriteByte(f,PalBMP[k].r shl 2);
  143.     WriteByte(f,PalBMP[k].z shl 2);
  144.   end;
  145.   FlushBuffer(f);
  146.   lin:=200;
  147.   OutBuffIndex:=0;
  148.   repeat
  149.     dec(lin);
  150.     for k:=0 to 319 do WriteByte(f,Mem[seg(PicPtr^):ofs(PicPtr^)+(lin*320)+k]);
  151.   until lin=0;
  152.   FlushBuffer(f);
  153.   CloseFile(f);
  154. end;
  155.  
  156. Function  LoadTGA(FileName:String; PalPtr:Pointer) : Pointer;
  157. Var
  158.   f:file; r:word; p:pointer;
  159.   lin,k : word;
  160.   Offset : word;
  161.   ImageType : Byte;
  162.   TGA_Head : record a,b,c:longint; DimX, DimY:Word; Pad,ImgType:byte end;
  163. begin {$i-}
  164.   BitMapError:=0; LoadTGA:=nil;
  165.   if not OpenForInput(f,FileName) then begin
  166.     BitMapError:=1; { File not found }
  167.     exit;
  168.   end;
  169.   if mavail<64000 then begin
  170.     BitMapError:=2; { Not enough memory }
  171.     CloseFile(f);
  172.     exit;
  173.   end;
  174.   p:=malloc(64000);
  175.   fillchar(p^,64000,0);
  176.   Seek(f,0);
  177.   ResetBuffer;
  178.   BlockRead(f,TGA_Head,18,k);
  179.   ImageType:=TGA_Head.ImgType;
  180.   for k:=0 to 255 do begin
  181.     mem[seg(PalPtr^):ofs(PalPtr^)+k*3+2]:=ReadByte(f) shr 2;
  182.     mem[seg(PalPtr^):ofs(PalPtr^)+k*3+1]:=ReadByte(f) shr 2;
  183.     mem[seg(PalPtr^):ofs(PalPtr^)+k*3+0]:=ReadByte(f) shr 2;
  184.   end;
  185.   Seek(f,18+256*3);
  186.   if ImageType=$20 then begin
  187.     lin:=0;
  188.     repeat
  189.       BlockRead(f,mem[seg(p^):ofs(p^)+lin*320],TGA_Head.DimX,k);
  190.       inc(lin);
  191.     until lin=TGA_Head.DimY;
  192.   end else begin
  193.     lin:=TGA_Head.DimY;
  194.     repeat
  195.       dec(lin);
  196.       BlockRead(f,mem[seg(p^):ofs(p^)+lin*320],TGA_Head.DimX,k);
  197.     until lin=0;
  198.   end;
  199.   CloseFile(f);
  200.   LoadTGA:=p;
  201. end;
  202.  
  203. Procedure SaveTGA(FileName:String; PalPtr,PicPtr:Pointer);
  204. var fo:file; r:word; sgn:string[3];
  205.     TGAp : Array [byte] of record b,g,r:byte end;
  206. const
  207.     TGA_Header:array [0..17] of byte = ( 0,1,1,0,0,0,1,$18,0,0,0,0,$40,1,$c8,0,8,$20 );
  208. begin {$i-}
  209.   BitMapError:=0;
  210.   if not OpenForOutput(fo,FileName) then begin
  211.     BitMapError:=5; { Cannot create file }
  212.     exit;
  213.   end;
  214.   BlockWrite(fo,TGA_Header,18);  { Writing TGA header }
  215.   for r:=0 to 255 do begin
  216.     TGAp[r].r:=mem[seg(PalPtr^):ofs(PalPtr^)+r*3] shl 2;
  217.     TGAp[r].g:=mem[seg(PalPtr^):ofs(PalPtr^)+r*3+1] shl 2;
  218.     TGAp[r].b:=mem[seg(PalPtr^):ofs(PalPtr^)+r*3+2] shl 2;
  219.   end;
  220.   BlockWrite(fo,TGAp,768,r);
  221.   if r<768 then begin
  222.     BitMapError:=6; { Disk full }
  223.     CloseFile(fo);
  224.     exit;
  225.   end;
  226.   BlockWrite(fo,PicPtr^,64000,r);
  227.   if r<64000 then begin
  228.     BitMapError:=6; { Disk full }
  229.     CloseFile(fo);
  230.     exit;
  231.   end;
  232.   CloseFile(fo);
  233. end;
  234.  
  235. Function  LoadEST(FileName:String; PalPtr:Pointer) : Pointer;
  236. type
  237. ESTHType = record
  238.              Sign        : LongInt;          { Signature 'ExST'}
  239.              RevisionNo  : Byte;             { Revision number (version) }
  240.              ImageType   : Byte;             { 0=Text, 1=BitMap, 2=Vect }
  241.              XDim,YDim   : Word;             { Dimensions }
  242.              HRes        : Word;             { Original Horiz. resolution }
  243.              VRes        : Word;             { Orig. vert. resolution }
  244.              BpColors    : Word;             { Bits/color (usually 8 or 4) }
  245.              Encode      : Byte;             { Compression method (0,1,2,3) }
  246.              ImageOffs   : Word;             { Image's start offset }
  247.              ImageInfo   : String[80];       { Image informations }
  248.              { Here might be other infos ... }
  249.              { ... }
  250.            end;
  251. var k:word; f:file; p:pointer; EST_Header:ESTHType;
  252. Procedure UnCompressRLE(var f:file);
  253. Var
  254.   XD : word;
  255.   Offset : Word;
  256.   NrOf,Last : Byte;
  257.   Counter : byte;
  258. begin {$i-}
  259.   Offset:=0;
  260.   ResetBuffer;
  261.   Repeat
  262.     NrOf:=ReadByte(f); Last:=ReadByte(f);
  263.     Counter:=0;
  264.     Repeat
  265.       if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  266.       Inc(Counter);
  267.       inc(Offset);
  268.       if Offset mod EST_Header.XDim = 0 then
  269.         Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  270.     Until Counter=NrOf;
  271.   Until (Offset>64000) or (InBuffIndex=0);
  272. end;
  273. Procedure UnCompressHRLE(var f:file);
  274. Var
  275.   XD        : word;
  276.   Offset    : Word;
  277.   NrOf,Last : Byte;
  278.   Counter   : byte;
  279. begin
  280.   Offset:=0;
  281.   ResetBuffer;
  282.   Repeat
  283.     NrOf:=ReadByte(f);
  284.     if NrOf>0 then begin { then it's a compressed block }
  285.       Last:=ReadByte(f);
  286.       Counter:=0;
  287.       { Uncompressing block ... }
  288.       Repeat
  289.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  290.         Inc(Counter);
  291.         inc(Offset);
  292.         if Offset mod EST_Header.XDim = 0 then
  293.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  294.       Until Counter=NrOf;
  295.     end else begin  { it's an uncompressed block }
  296.       NrOf:=ReadByte(f);
  297.       Counter:=0;
  298.       { Extracting the uncompressed block ... }
  299.       Repeat
  300.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=ReadByte(f);
  301.         Inc(Counter);
  302.         inc(Offset);
  303.         if Offset mod EST_Header.XDim = 0 then
  304.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  305.       Until Counter=NrOf;
  306.     end;
  307.   Until (Offset>64000) or (InBuffIndex=0);
  308. end;
  309. Procedure UnCompressXRLE(var f:file);
  310. Var
  311.   XD        : word;
  312.   Offset    : Word;
  313.   NrOf,Last : Byte;
  314.   Counter   : byte;
  315. begin
  316.   Offset:=0;
  317.   ResetBuffer;
  318.   Repeat
  319.     NrOf:=ReadByte(f);
  320.     if ShortInt(NrOf)>0 then begin { then it's a compressed block }
  321.       Last:=ReadByte(f);
  322.       Counter:=0;
  323.       { Uncompressing block ... }
  324.       Repeat
  325.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  326.         Inc(Counter);
  327.         inc(Offset);
  328.         if Offset mod EST_Header.XDim = 0 then
  329.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  330.       Until Counter=NrOf;
  331.     end else begin  { it's an uncompressed block }
  332.       NrOf:=Byte(-ShortInt(NrOf));
  333.       Counter:=0;
  334.       { Extracting the uncompressed block ... }
  335.       Repeat
  336.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=ReadByte(f);
  337.         Inc(Counter);
  338.         inc(Offset);
  339.         if Offset mod EST_Header.XDim = 0 then
  340.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  341.       Until Counter=NrOf;
  342.     end;
  343.   Until (Offset>64000) or (InBuffIndex=0);
  344. end;
  345. begin {$i-}
  346.   BitMapError:=0; LoadEST:=nil;
  347.   if not OpenForInput(f,FileName)then begin
  348.     BitMapError:=1; { File not found }
  349.     exit;
  350.   end;
  351.   p:=malloc(64016);
  352.   if p=nil then begin
  353.     BitMapError:=2; { Not enough memory }
  354.     CloseFile(f);
  355.     exit;
  356.   end;
  357.   fillchar(p^,64000,0);
  358.   BlockRead(f,EST_Header,SizeOf(EST_Header),k);      { Citeste header }
  359.   if EST_Header.Sign<>$54537845 then begin
  360.     CloseFile(f);
  361.     BitMapError:=3; { Invalid format }
  362.     Free(p);
  363.     exit;
  364.   end;
  365.   BlockRead(f,PalPtr^,768,k);
  366.   if k<768 then begin
  367.     CloseFile(f);
  368.     BitMapError:=4; { Corrupted picture }
  369.     Free(p);
  370.     exit;
  371.   end;
  372.   Seek(f,EST_Header.ImageOffs);
  373.   case EST_Header.Encode of
  374.     0: BlockRead(f,p^,64000,k);  { No encoded }
  375.     1: UncompressRLE(f);         { Run-Length Encoded }
  376.     2: UncompressHRLE(f);        { Hard Run-Length Encoded }
  377.     3: UncompressXRLE(f);        { Extra Run-Length Encoded }
  378.   end;
  379.   CloseFile(f);
  380.   LoadEST:=p;
  381. end;
  382.  
  383. Function  LoadESTFromFile(var f:file; PalPtr:Pointer) : Pointer;
  384. type
  385. ESTHType = record
  386.              Sign        : LongInt;          { Signature 'ExST'}
  387.              RevisionNo  : Byte;             { Revision number (version) }
  388.              ImageType   : Byte;             { 0=Text, 1=BitMap, 2=Vect }
  389.              XDim,YDim   : Word;             { Dimensions }
  390.              HRes        : Word;             { Original Horiz. resolution }
  391.              VRes        : Word;             { Orig. vert. resolution }
  392.              BpColors    : Word;             { Bits/color (usually 8 or 4) }
  393.              Encode      : Byte;             { Compression method (Not=0) }
  394.              ImageOffs   : Word;             { Image's start offset }
  395.              ImageInfo   : String[80];       { Image informations }
  396.              { Here might be other infos ... }
  397.              { ... }
  398.            end;
  399. var k:word; p:pointer; EST_Header:ESTHType; origpos:longint;
  400. Procedure UnCompressRLE(var f:file);
  401. Var
  402.   XD : word;
  403.   Offset : Word;
  404.   NrOf,Last : Byte;
  405.   Counter : byte;
  406. begin {$i-}
  407.   Offset:=0;
  408.   ResetBuffer;
  409.   Repeat
  410.     NrOf:=ReadByte(f); Last:=ReadByte(f);
  411.     Counter:=0;
  412.     Repeat
  413.       if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  414.       Inc(Counter);
  415.       inc(Offset);
  416.       if Offset mod EST_Header.XDim = 0 then
  417.         Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  418.     Until Counter=NrOf;
  419.   Until (Offset>64000) or (InBuffIndex=0);
  420. end;
  421. Procedure UnCompressHRLE(var f:file);
  422. Var
  423.   XD        : word;
  424.   Offset    : Word;
  425.   NrOf,Last : Byte;
  426.   Counter   : byte;
  427. begin
  428.   Offset:=0;
  429.   ResetBuffer;
  430.   Repeat
  431.     NrOf:=ReadByte(f);
  432.     if NrOf>0 then begin { then it's a compressed block }
  433.       Last:=ReadByte(f);
  434.       Counter:=0;
  435.       { Uncompressing block ... }
  436.       Repeat
  437.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  438.         Inc(Counter);
  439.         inc(Offset);
  440.         if Offset mod EST_Header.XDim = 0 then
  441.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  442.       Until Counter=NrOf;
  443.     end else begin  { it's an uncompressed block }
  444.       NrOf:=ReadByte(f);
  445.       Counter:=0;
  446.       { Extracting the uncompressed block ... }
  447.       Repeat
  448.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=ReadByte(f);
  449.         Inc(Counter);
  450.         inc(Offset);
  451.         if Offset mod EST_Header.XDim = 0 then
  452.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  453.       Until Counter=NrOf;
  454.     end;
  455.   Until (Offset>64000) or (InBuffIndex=0);
  456. end;
  457. Procedure UnCompressXRLE(var f:file);
  458. Var
  459.   XD        : word;
  460.   Offset    : Word;
  461.   NrOf,Last : Byte;
  462.   Counter   : byte;
  463. begin
  464.   Offset:=0;
  465.   ResetBuffer;
  466.   Repeat
  467.     NrOf:=ReadByte(f);
  468.     if ShortInt(NrOf)>0 then begin { then it's a compressed block }
  469.       Last:=ReadByte(f);
  470.       Counter:=0;
  471.       { Uncompressing block ... }
  472.       Repeat
  473.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=Last;
  474.         Inc(Counter);
  475.         inc(Offset);
  476.         if Offset mod EST_Header.XDim = 0 then
  477.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  478.       Until Counter=NrOf;
  479.     end else begin  { it's an uncompressed block }
  480.       NrOf:=Byte(-ShortInt(NrOf));
  481.       Counter:=0;
  482.       { Extracting the uncompressed block ... }
  483.       Repeat
  484.         if offset<64000 then Mem[seg(p^):ofs(p^)+Offset]:=ReadByte(f);
  485.         Inc(Counter);
  486.         inc(Offset);
  487.         if Offset mod EST_Header.XDim = 0 then
  488.           Offset:=Offset+EST_Header.HRes-EST_Header.XDim;
  489.       Until Counter=NrOf;
  490.     end;
  491.   Until (Offset>64000) or (InBuffIndex=0);
  492. end;
  493. begin {$i-}
  494.   BitMapError:=0; LoadESTFromFile:=nil;
  495.   OrigPos:=FilePos(f);
  496.   p:=malloc(64016);
  497.   if p=nil then begin
  498.     BitMapError:=2; { Not enough memory }
  499.     exit;
  500.   end;
  501.   fillchar(p^,64000,0);
  502.   BlockRead(f,EST_Header,SizeOf(EST_Header),k);      { Citeste header }
  503.   if EST_Header.Sign<>$54537845 then begin
  504.     BitMapError:=3; { Invalid format }
  505.     Free(p);
  506.     exit;
  507.   end;
  508.   BlockRead(f,PalPtr^,768,k);
  509.   if k<768 then begin
  510.     BitMapError:=4; { Corrupted picture }
  511.     Free(p);
  512.     exit;
  513.   end;
  514.   Seek(f,OrigPos+LongInt(EST_Header.ImageOffs));
  515.   case EST_Header.Encode of
  516.     0: BlockRead(f,p^,64000,k);  { No encoded }
  517.     1: UncompressRLE(f);         { Run-Length Encoded }
  518.     2: UncompressHRLE(f);        { Hard Run-Length Encoded }
  519.     3: UncompressXRLE(f);        { Extra Run-Length Encoded }
  520.   end;
  521.   LoadESTFromFile:=p;
  522. end;
  523.  
  524. Procedure SaveEST(FileName:String; PalPtr,PicPtr:Pointer);
  525. type
  526. ESTHType = record
  527.              Sign        : LongInt;          { Signature 'ExST'}
  528.              RevisionNo  : Byte;             { Revision number (version) }
  529.              ImageType   : Byte;             { 0=Text, 1=BitMap, 2=Vect }
  530.              XDim,YDim   : Word;             { Dimensions }
  531.              HRes        : Word;             { Original Horiz. resolution }
  532.              VRes        : Word;             { Orig. vert. resolution }
  533.              BpColors    : Word;             { Bits/color (usually 8 or 4) }
  534.              Encode      : Byte;             { Compression method (None=0) }
  535.              ImageOffs   : Word;             { Image's start offset }
  536.              ImageInfo   : String[80];       { Image informations }
  537.              { Here might be other infos ... }
  538.              { ... }
  539.            end;
  540. var fo:file; r:word;
  541.     k:word;
  542.     EST_Header:ESTHType;
  543.     Last:Byte;
  544.     NrOf:Word;
  545.     Offset,AuxOffset:Word;
  546. begin {$i-}
  547.   if not OpenForOutput(fo,FileName) then begin
  548.     BitMapError:=5; { Cannot create file }
  549.     exit;
  550.   end;
  551.   fillchar(EST_Header,sizeof(EST_Header),0);
  552.   with EST_Header do begin
  553.     Sign:=$54537845;  { 'ExST' }
  554.     ImageType:=1;
  555.     RevisionNo:=4;
  556.     XDim:=320; YDim:=200;
  557.     HRes:=320; VRes:=200;
  558.     BpColors:=8;
  559.     Encode:=3; { Extra Run Length Encoding }
  560.     ImageOffs:=SizeOf(EST_Header)+768;
  561.     ImageInfo:='Bitmap library v4.12, by Maple Leaf, 1996';
  562.   end;
  563.   BlockWrite(fo,EST_header,SizeOf(EST_Header),k);
  564.   BlockWrite(fo,PalPtr^,768,k);
  565.   Offset:=0;
  566.   OutBuffIndex:=0;
  567.   repeat
  568.     Last:=Mem[seg(PicPtr^):Ofs(PicPtr^)+Offset];
  569.     NrOf:=0;
  570.     while (mem[seg(PicPtr^):ofs(PicPtr^)+Offset]=Last) and (Offset<64000) and (NrOf<$7F) do begin
  571.       inc(NrOf); Inc(Offset);
  572.     end;
  573.     if NrOf<2 then begin
  574.       AuxOffset:=Offset-1;
  575.       Last:=Mem[seg(PicPtr^):ofs(PicPtr^)+AuxOffset];
  576.       NrOf:=1;
  577.       while (Last<>Mem[seg(PicPtr^):ofs(PicPtr^)+Offset]) and (Offset<64000) and (NrOf<$80) do begin
  578.         inc(NrOf);
  579.         Last:=Mem[seg(PicPtr^):ofs(PicPtr^)+Offset];
  580.         inc(Offset);
  581.       end;
  582.       if (mem[seg(PicPtr^):ofs(PicPtr^)+Offset-1]=mem[seg(PicPtr^):ofs(PicPtr^)+Offset]) and
  583.          (Offset<=64000) and (NrOf<=$80) then begin
  584.         dec(Offset);
  585.         dec(NrOf);  { Keeps the latest byte for a new check }
  586.       end;
  587.       WriteByte(fo,Byte(ShortInt(-NrOf)));  { Size of uncompressed block }
  588.       { Write the uncompressed block ... }
  589.       for k:=0 to NrOf-1 do WriteByte(fo,Mem[seg(PicPtr^):Ofs(PicPtr^)+AuxOffset+k]);
  590.     end else begin
  591.       WriteByte(fo,NrOf);  { Size of compressed block }
  592.       WriteByte(fo,Last);  { Char to fill with }
  593.     end;
  594.   until (Offset>=64000);
  595.   FlushBuffer(fo);
  596.   if FileSize(fo)>64000+SizeOf(EST_Header)+768 then begin
  597.     { Compression wasn't efficient, so just store the image as it is }
  598.     with EST_Header do begin
  599.       Sign:=$54537845;  { 'ExST' }
  600.       ImageType:=1;
  601.       RevisionNo:=4;
  602.       XDim:=320; YDim:=200;
  603.       HRes:=320; VRes:=200;
  604.       BpColors:=8;
  605.       Encode:=0; { No encoding }
  606.       ImageOffs:=SizeOf(EST_Header)+768;
  607.       ImageInfo:='Bitmap library v4.12, by Maple Leaf, 1996';
  608.     end;
  609.     Seek(fo,0); 
  610.     BlockWrite(fo,EST_Header,sizeof(EST_Header),r);
  611.     BlockWrite(fo,PalPtr^,768,k);
  612.     BlockWrite(fo,PicPtr^,64000,k);
  613.     Truncate(fo);
  614.   end;
  615.   CloseFile(fo);
  616. end;
  617.  
  618. Function  LoadBIN(FileName:String; PalPtr:Pointer) : Pointer;
  619. var fi:file;
  620.     p:pointer;
  621.     r:word;
  622. begin {$i-}
  623.   BitMapError:=0; LoadBIN:=nil;
  624.   if not OpenForInput(fi,FileName) then begin
  625.     BitMapError:=1; { File not found }
  626.     exit;
  627.   end;
  628.   if mavail<64000 then begin
  629.     BitMapError:=2; { Not enough memory }
  630.     CloseFile(fi);
  631.     exit;
  632.   end;
  633.   BlockRead(fi,PalPtr^,768,r);
  634.   if r<768 then begin
  635.     BitMapError:=4; { Corrupted picture }
  636.     CloseFile(fi);
  637.     exit;
  638.   end;
  639.   p:=malloc(64000);
  640.   FillChar(p^,64000,0);
  641.   BlockRead(fi,p^,64000,r);
  642.   if r<64000 then begin
  643.     BitMapError:=4; { Corrupted picture }
  644.     Free(p);
  645.     CloseFile(fi);
  646.     exit;
  647.   end;
  648.   CloseFile(fi);
  649.   LoadBIN:=p;
  650. end;
  651.  
  652. Procedure SaveBIN(FileName:String; PalPtr,PicPtr:Pointer);
  653. var fo:file; r:word; sgn:string[3];
  654. begin {$i-}
  655.   BitMapError:=0;
  656.   if not OpenForOutput(fo,FileName) then begin
  657.     BitMapError:=5; { Cannot create file }
  658.     exit;
  659.   end;
  660.   BlockWrite(fo,PalPtr^,768,r);
  661.   if r<768 then begin
  662.     BitMapError:=6; { Disk full }
  663.     CloseFile(fo);
  664.     exit;
  665.   end;
  666.   BlockWrite(fo,PicPtr^,64000,r);
  667.   if r<64000 then begin
  668.     BitMapError:=6; { Disk full }
  669.     CloseFile(fo);
  670.     exit;
  671.   end;
  672.   CloseFile(fo);
  673. end;
  674.  
  675. Function SwapLong(n:longint):longint;assembler;
  676. asm
  677.   mov ax,word ptr n+2
  678.   mov dx,word ptr n
  679.   xchg al,ah
  680.   xchg dl,dh
  681. end;
  682.  
  683. Function  LoadLBM(FileName:String; PalPtr:Pointer) : Pointer;
  684. type
  685.   FORM_chunk = record ckID, CkSize, SubType : LongInt end;
  686.   Chunk      = record ckID, ckSize : LongInt end;
  687.   LBMHeader  = record
  688.                  DimX, DimY, PosX, PosY : Word;
  689.                  Planes, Masking, Compression, Pad1 : Byte;
  690.                  TranspCol : Word;
  691.                  xAspect, yAspect : Byte;
  692.                  PageWidth, PageHeight : Word;
  693.                end;
  694. const
  695.   LBM_FORM   = $4D524F46;  { 'FORM' }
  696.   LBM_ILBM   = $4D424C49;  { 'ILBM' }
  697.   LBM_BMHD   = $44484D42;  { 'BMHD' }
  698.   LBM_CMAP   = $50414D43;  { 'CMAP' }
  699.   LBM_BODY   = $59444F42;  { 'BODY' }
  700.   LBM_TEXT   = $54584554;  { 'TEXT' }
  701.   LBM_PBM    = $204D4250;  { 'PBM ' }
  702. var
  703.   Pal:Array[byte] of record r,g,b:byte end;
  704.   f:file; p:pointer;
  705.   chk:Chunk;
  706.   fc:FORM_chunk;
  707.   bh:LBMHeader;
  708.   r:word;
  709.   Gata:boolean;
  710.   Offset:Word;
  711.   Value:ShortInt; SoFar,Len,Count:Integer;
  712. begin {$i-}
  713.   BitMapError:=0; LoadLBM:=nil;
  714.   if not OpenForInput(f,FileName) then begin
  715.     BitMapError:=1; { File not found }
  716.     exit;
  717.   end;
  718.   if mavail<64000 then begin
  719.     BitMapError:=2; { Not enough memory }
  720.     CloseFile(f);
  721.     exit;
  722.   end;
  723.   p:=malloc(64000);
  724.   FillChar(p^,64000,0);
  725.   seek(f,0);
  726.   BlockRead(f,fc,12);
  727.   if (fc.SubType<>LBM_PBM) then begin
  728.     BitMapError:=7; { Invalid format (not BPM) }
  729.     Free(p);
  730.     CloseFile(f);
  731.     exit;
  732.   end;
  733.   BlockRead(f,chk,8);
  734.   if chk.ckID<>LBM_BMHD then begin
  735.     BitMapError:=8; { Invalid format (missing BMHD) }
  736.     Free(p);
  737.     CloseFile(f);
  738.     exit;
  739.   end;
  740.   BlockRead(f,bh,20);
  741.   with bh do begin
  742.     DimX:=Swap(DimX); DimY:=Swap(DimY); PosX:=Swap(PosX); PosY:=Swap(PosY);
  743.     PageWidth:=Swap(PageWidth); PageHeight:=Swap(PageHeight);
  744.     if (PageWidth<>320) or (PageHeight<>200) or (Planes<>8) then begin
  745.       BitMapError:=9; { Not a 320x200/256 image }
  746.       Free(p);
  747.       CloseFile(f);
  748.       exit;
  749.     end;
  750.     if (Compression>1) then begin
  751.       BitMapError:=10; { Unknown compression method }
  752.       Free(p);
  753.       CloseFile(f);
  754.       exit;
  755.     end;
  756.   end;
  757.   BlockRead(f,chk,8);
  758.   if (chk.ckID<>LBM_CMAP) or (SwapLong(chk.ckSize)<>768) then begin
  759.     BitMapError:=11; { Invalid CMAP chunk }
  760.     Free(p);
  761.     CloseFile(f);
  762.     exit;
  763.   end;
  764.   { Read palette }
  765.   BlockRead(f,Pal,768,r);
  766.   for r:=0 to 255 do begin
  767.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3]:=Pal[r].r shr 2;
  768.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3+1]:=Pal[r].g shr 2;
  769.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3+2]:=Pal[r].b shr 2;
  770.   end;
  771.   Gata:=False;
  772.   Repeat
  773.     BlockRead(f,chk,8);
  774.     if chk.ckID<>LBM_BODY then begin
  775.       { Just skip it ... }
  776.       Seek(f,FilePos(f)+SwapLong(chk.ckSize));
  777.       Gata:=false;
  778.     end else begin
  779.       { BODY, so decompress ... }
  780.       if bh.Compression=0 then begin
  781.         Offset:=0;
  782.         while bh.DimY>0 do begin
  783.           BlockRead(f,mem[seg(p^):ofs(p^)+Offset],bh.DimX,r);
  784.           inc(Offset,bh.PageWidth);
  785.           dec(bh.DimY);
  786.         end;
  787.         Gata:=True;
  788.       end else begin
  789.         { RLE }
  790.         ResetBuffer;
  791.         Offset:=0;
  792.         while (bh.DimY>0) do begin
  793.           SoFar:=bh.DimX;
  794.           if SoFar and 1 <> 0 then Inc(SoFar);
  795.           while SoFar>0 do begin
  796.             Value:=ShortInt(ReadByte(f));
  797.             if Value>0 then begin
  798.               Len:=Integer(Value)+1;
  799.               SoFar:=SoFar-Len;
  800.               for r:=1 to Len do begin
  801.                 Mem[seg(p^):ofs(p^)+Offset]:=ReadByte(f);
  802.                 Inc(Offset);
  803.               end;
  804.             end else begin
  805.               Count:=Integer(-Value); Inc(Count);
  806.               SoFar:=SoFar-Count;
  807.               Value:=ShortInt(ReadByte(f));
  808.               for r:=1 to Count do begin
  809.                 Mem[seg(p^):ofs(p^)+Offset]:=Byte(Value);
  810.                 Inc(Offset);
  811.               end;
  812.             end;
  813.           end;
  814.           dec(bh.DimY);
  815.           Offset:=Offset+bh.PageWidth-bh.DimX;
  816.         end;
  817.         Gata:=True;
  818.       end;
  819.     end;
  820.     if FilePos(f)>=FileSize(f) then Gata:=True;
  821.   Until Gata;
  822.   CloseFile(f);
  823.   LoadLBM:=p;
  824. end;
  825.  
  826. Procedure SaveLBM(FileName:String; PalPtr,PicPtr:Pointer);
  827. type
  828.   FORM_chunk = record ckID, CkSize, SubType : LongInt end;
  829.   Chunk      = record ckID, ckSize : LongInt end;
  830.   LBMHeader  = record
  831.                  DimX, DimY, PosX, PosY : Word;
  832.                  Planes, Masking, Compression, Pad1 : Byte;
  833.                  TranspCol : Word;
  834.                  xAspect, yAspect : Byte;
  835.                  PageWidth, PageHeight : Word;
  836.                end;
  837. const
  838.   LBM_FORM   = $4D524F46;  { 'FORM' }
  839.   LBM_ILBM   = $4D424C49;  { 'ILBM' }
  840.   LBM_BMHD   = $44484D42;  { 'BMHD' }
  841.   LBM_CMAP   = $50414D43;  { 'CMAP' }
  842.   LBM_BODY   = $59444F42;  { 'BODY' }
  843.   LBM_TEXT   = $54584554;  { 'TEXT' }
  844.   LBM_PBM    = $204D4250;  { 'PBM ' }
  845. var
  846.   f:file; r:word;
  847.   k : byte;
  848.   lulu : word;
  849.   { File size (FORM) }
  850.   fsz : longint;
  851.   fszamiga : record h,l:word end absolute fsz;
  852.   { Compressed size (BODY) }
  853.   csz : longint;
  854.   cszamiga : record h,l:word end absolute csz;
  855.   fc : FORM_chunk;
  856.   chk : Chunk;
  857.   bh : LBMHeader;
  858.   { Used for compression... }
  859.   Last:Byte;
  860.   NrOf:Word;
  861.   Offset,AuxOffset:Word;
  862.   aux:word;
  863.   yo___:LongInt;
  864.   _EOL:boolean;
  865. begin {$i-}
  866.   if not OpenForOutput(f,FileName) then begin
  867.     BitMapError:=5; { Cannot create file }
  868.     exit;
  869.   end;
  870.   OutBuffIndex:=0;
  871.   { Write FORM chunk ... }
  872.   fc.ckID:=LBM_FORM;
  873.   fc.SubType:={LBM_ILBM;}LBM_PBM;
  874.   BlockWrite(f, fc, 12);
  875.   { Write BMHD chunk ... }
  876.   chk.ckID:=LBM_BMHD;
  877.   chk.ckSize:=$14000000;
  878.   BlockWrite(f,chk,8);
  879.   { Write BitMap Header }
  880.   bh.DimX:=Swap(320); bh.DimY:=Swap(200);
  881.   bh.PosX:=0; bh.PosY:=0;
  882.   bh.Planes:=8; bh.Masking:=0;
  883.   { ++++++++++ }
  884.   bh.Compression:=1;
  885.   { ++++++++++ }
  886.   bh.Pad1:=0; { Unused }
  887.   bh.TranspCol:=Swap($BF);
  888.   bh.xAspect:=$5; bh.yAspect:=$6;
  889.   bh.PageWidth:=Swap(320); bh.PageHeight:=Swap(200);
  890.   BlockWrite(f, bh, $14);
  891.   { Write CMAP chunk }
  892.   chk.ckID:=LBM_CMAP;
  893.   chk.ckSize:=$00030000;  { 768 (300h) in Amiga format }
  894.   BlockWrite(f,chk,8);
  895.   { Write palette }
  896.   for k:=0 to 255 do begin
  897.     WriteByte(f, mem[seg(PalPtr^):ofs(PalPtr^)+k*3] shl 2);
  898.     WriteByte(f, mem[seg(PalPtr^):ofs(PalPtr^)+k*3+1] shl 2);
  899.     WriteByte(f, mem[seg(PalPtr^):ofs(PalPtr^)+k*3+2] shl 2);
  900.   end;
  901.   FlushBuffer(f); { Flush the output buffer }
  902.   { Write TEXT chunk and the text after it }
  903.   chk.ckID:=LBM_TEXT;
  904.   chk.ckSize:=$04000000;
  905.   BlockWrite(f,chk,8);
  906.   chk.ckID:=$4B435546; { "FUCK" }
  907.   BlockWrite(f,chk,4);
  908.   { Write BODY chunk }
  909.   chk.ckID:=LBM_BODY;
  910.   yo___:=FilePos(f);
  911.   BlockWrite(f,chk,8);
  912.   { Compress body with RLE }
  913.   csz:=0;
  914.   Offset:=0;
  915.   OutBuffIndex:=0;
  916.   repeat
  917.     Last:=Mem[seg(PicPtr^):ofs(PicPtr^)+Offset];
  918.     NrOf:=0;
  919.     _EOL:=false;
  920.     while (mem[seg(PicPtr^):ofs(PicPtr^)+Offset]=Last) and (Offset<64000) and
  921.           (NrOf<127) and not _EOL do begin
  922.       inc(NrOf); Inc(Offset);
  923.       if Offset mod 320=0 then _EOL:=true;
  924.     end;
  925.     if NrOf<2 then begin
  926.       { Uncompressed block }
  927.       AuxOffset:=Offset-1;
  928.       Last:=Mem[seg(PicPtr^):ofs(PicPtr^)+AuxOffset];
  929.       NrOf:=1;
  930.       while (Last<>Mem[seg(PicPtr^):ofs(PicPtr^)+Offset]) and (Offset<64000) and (NrOf<127) and not _EOL do begin
  931.         inc(NrOf);
  932.         Last:=Mem[seg(PicPtr^):ofs(PicPtr^)+Offset];
  933.         inc(Offset);
  934.         if Offset mod 320 = 0 then _EOL:=true;
  935.       end;
  936.       if (mem[seg(PicPtr^):ofs(PicPtr^)+Offset-1]=mem[seg(PicPtr^):ofs(PicPtr^)+Offset]) and (Offset<=64000) and
  937.          (NrOf<=127) and not _EOL then begin
  938.         dec(Offset);
  939.         dec(NrOf);  { Keeps the latest byte for a new check }
  940.       end;
  941.       WriteByte(f,NrOf-1);  { Size of uncompressed block }
  942.       { Write the uncompressed block ... }
  943.       for k:=0 to NrOf-1 do WriteByte(f,Mem[seg(PicPtr^):ofs(PicPtr^)+AuxOffset+k]);
  944.       csz:=csz+1+NrOf;
  945.     end else begin
  946.       WriteByte(f,Byte(-NrOf)+1);  { Size of compressed block }
  947.       WriteByte(f,Last);  { Char to fill with }
  948.       csz:=csz+2;
  949.     end;
  950.     if FileSize(f)>200*1024 then begin FlushBuffer(f); exit; end;
  951.   until (Offset>=64000);
  952.   FlushBuffer(f);
  953.   if csz>64000 then begin
  954.     { If it was expanded, then just store it (compression=0) }
  955.     csz:=64000;
  956.     seek(f,yo___+8);
  957.     BlockWrite(f,mem[seg(PicPtr^):Ofs(PicPtr^)],64000);
  958.     Truncate(f);
  959.     seek(f,20);
  960.     bh.Compression:=0;
  961.     BlockWrite(f,bh,$14);
  962.   end;
  963.   { Swap up for the fuckin' Motorola CPU and write BODY chunk again }
  964.   aux:=cszamiga.h; cszamiga.h:=cszamiga.l; cszamiga.l:=aux;
  965.   cszamiga.l:=Swap(cszamiga.l);
  966.   cszamiga.h:=Swap(cszamiga.h);
  967.   Seek(f,yo___+4);
  968.   BlockWrite(f,cszamiga,4);
  969.   { Write FORM chunk again }
  970.   fsz:=FileSize(f)-8;
  971.   aux:=fszamiga.h; fszamiga.h:=fszamiga.l; fszamiga.l:=aux;
  972.   fszamiga.l:=Swap(fszamiga.l);
  973.   fszamiga.h:=Swap(fszamiga.h);
  974.   Seek(f,4);
  975.   BlockWrite(f,fszamiga,4);
  976.   CloseFile(f); BitMapError:=0;
  977. end;
  978.  
  979. Function  LoadPIC(FileName:String; PalPtr:Pointer) : Pointer;
  980. Var
  981.   f:file; p:pointer;
  982.   head : record
  983.     sign : word;
  984.     xdim,ydim,xpos,ypos:word;
  985.     bpp:byte;
  986.     bug:byte;
  987.     mode:char;
  988.     ei_descr:word;
  989.     ei_sz:word;
  990.   end;
  991.   bpacked,n:word;
  992.   marker : byte;
  993.   count : word;
  994.   RLEb : word;
  995.   packeds,unpackeds : word;
  996.   remained, r : word;
  997.   cbyte:byte;
  998.   Offs:Word;
  999.   x,y:integer;
  1000. Procedure DrawRLE(count:word; b:byte);
  1001. var k:word;
  1002. begin
  1003.   k:=0;
  1004.   while (k<count) and (y>=0) do begin
  1005.     mem[seg(p^):ofs(p^)+(y*320+x)]:=b;
  1006.     inc(x); if x>=head.xdim then begin x:=0; dec(y) end;
  1007.     inc(k);
  1008.   end;
  1009. end;
  1010. begin {$i-}
  1011.   BitMapError:=0; LoadPIC:=nil;
  1012.   if not OpenForInput(f,FileName) then begin
  1013.     BitMapError:=1;
  1014.     Exit;
  1015.   end;
  1016.   if mavail<64000 then begin
  1017.     BitMapError:=2; { Not enough memory }
  1018.     CloseFile(f);
  1019.     exit;
  1020.   end;
  1021.   p:=malloc(64000);
  1022.   fillchar(p^,64000,0);
  1023.   ResetBuffer;
  1024.   BlockRead(f,head,sizeof(head),r);
  1025.   if head.sign<>$1234 then begin
  1026.     BitMapError:=3; { Invalid format }
  1027.     closefile(f); Free(p);
  1028.     exit;
  1029.   end;
  1030.   if head.mode<>'L' then begin
  1031.     BitMapError:=9; { Not a 320x200/256 image }
  1032.     closefile(f); Free(p);
  1033.     exit;
  1034.   end;
  1035.   seek(f,SizeOf(head));
  1036.   if head.ei_descr=4 then BlockRead(f,PalPtr^,768,r);
  1037.   seek(f,sizeof(head)+head.ei_sz);
  1038.   blockread(f,bpacked,2,r);
  1039.   if bpacked=0 then begin
  1040.     BitMapError:=10; { Unknown compression method }
  1041.     closefile(f); Free(p);
  1042.     exit;
  1043.   end;
  1044.   {if head.ei_descr=4 then setall(@pal);}
  1045.   x:=head.xpos; y:=head.ydim-head.ypos-1;
  1046.   for n:=1 to bpacked do begin
  1047.     { Unpack each block ... }
  1048.     PackedS:=Word(ReadByte(f));
  1049.     PackedS:=PackedS+(ReadByte(f) shl 8);
  1050.     UnPackedS:=ReadByte(f);
  1051.     UnPackedS:=UnPackedS+(ReadByte(f) shl 8);
  1052.     marker:=ReadByte(f);
  1053.     Remained:=PackedS-5; { 5 = 2 (PackedS) + 2 (UnPackedS) + 1 (Marker) }
  1054.     while Remained>0 do begin
  1055.       cbyte:=ReadByte(f); dec(Remained);
  1056.       if cbyte<>marker then begin
  1057.         mem[seg(p^):ofs(p^)+(y*320+x)]:=cbyte;
  1058.         inc(x); if x>=head.xdim then begin x:=0; dec(y) end;
  1059.       end else begin
  1060.         cbyte:=ReadByte(f); dec(Remained);
  1061.         if cbyte<>0 then
  1062.           Count:=cbyte
  1063.         else begin
  1064.           Count:=ReadByte(f);
  1065.           Count:=Count+(ReadByte(f) shl 8);
  1066.           dec(Remained,2);
  1067.         end;
  1068.         RLEb:=ReadByte(f);
  1069.         Dec(Remained);
  1070.         DrawRLE(Count,RLEb);
  1071.       end;
  1072.     end;
  1073.   end;
  1074.   CloseFile(f);
  1075.   BitMapError:=0; LoadPIC:=p;
  1076. end;
  1077.  
  1078. Function  LoadPCX(FileName:String; PalPtr:Pointer) : Pointer;
  1079. type
  1080.   PCXHType         = record
  1081.     Manufacturer   : byte;                  { Always =10 for Paintbrush   }
  1082.     Version        : byte;                  { Version information         }
  1083.     Encoding       : byte;                  { Run-length encoding (=???)  }
  1084.     BitsPerPixel   : byte;                  { Bits per pixel              }
  1085.     MinX           : word;                  { Picture dimensions (incl)   }
  1086.     MinY           : word;                  {                             }
  1087.     MaxX           : word;                  {                             }
  1088.     MaxY           : word;                  {                             }
  1089.     HorizRes       : word;                  { Display horiz resolution    }
  1090.     VertRes        : word;                  { Display vert  resolution    }
  1091.     Pal16          : array[0..47] of byte;  { Pallete                     }
  1092.     VMode          : byte;                  { (ignored,=0)                }
  1093.     ColPlanes      : byte;                  { Number of planes (ver 2.5=0)}
  1094.     BytesPerLine   : word;                  { Bytes per line              }
  1095.     PalInfo        : word;                  { Palette Info (1=col, 2=gray)}
  1096.     shres          : word;                  { Scanner resolution          }
  1097.     svres          : word;                  {                             }
  1098.     xtra           : array[0..54] of byte;  { Extra space (filler)        }
  1099.   end;
  1100. var
  1101.   Pal:Array[byte] of record r,g,b:byte end;
  1102.   f:file; p:pointer;
  1103.   bh:PCXHType;
  1104.   r:word; palsgn:byte;
  1105.   Gata:boolean;
  1106.   Offset:Word;
  1107.   Value,Counter:Byte;
  1108.   y,x,xx:integer;
  1109. begin {$i-}
  1110.   BitMapError:=0; LoadPCX:=nil;
  1111.   if not OpenForInput(f,FileName) then begin
  1112.     BitMapError:=1; { File not found }
  1113.     exit;
  1114.   end;
  1115.   if mavail<64000 then begin
  1116.     BitMapError:=2; { Not enough memory }
  1117.     CloseFile(f);
  1118.     exit;
  1119.   end;
  1120.   p:=malloc(64000);
  1121.   FillChar(p^,64000,0);
  1122.   seek(f,0);
  1123.   BlockRead(f,bh,sizeof(bh),r);
  1124.   with bh do begin
  1125.     if (BitsPerPixel<>8) or (MaxX>320) or (MaxY>200) then begin
  1126.       BitMapError:=9; { Not a 320x200/256 image }
  1127.       Free(p);
  1128.       CloseFile(f);
  1129.       exit;
  1130.     end;
  1131.     if (Encoding<>1) then begin
  1132.       BitMapError:=10; { Unknown compression method }
  1133.       Free(p);
  1134.       CloseFile(f);
  1135.       exit;
  1136.     end;
  1137.   end;
  1138.   seek(f,filesize(f)-769);
  1139.   BlockRead(f,PalSgn,1,r);
  1140.   if PalSgn<>12 then begin
  1141.     BitMapError:=12; { Invalid palette (PCX) }
  1142.     Free(p);
  1143.     CloseFile(f);
  1144.     exit;
  1145.   end;
  1146.   { Read palette }
  1147.   BlockRead(f,Pal,768,r);
  1148.   for r:=0 to 255 do begin
  1149.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3]:=Pal[r].r shr 2;
  1150.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3+1]:=Pal[r].g shr 2;
  1151.     mem[seg(PalPtr^):ofs(PalPtr^)+r*3+2]:=Pal[r].b shr 2;
  1152.   end;
  1153.   Gata:=False;
  1154.   { RLE }
  1155.   Seek(f,sizeof(bh)-1); { ??? }
  1156.   ResetBuffer;
  1157.   Offset:=0;
  1158.   for y:=0 to bh.MaxY do begin
  1159.     xx:=bh.MaxX+1;
  1160.     repeat
  1161.       value:=ReadByte(f);
  1162.       if value and $C0 = $C0 then begin
  1163.         { Run the counter }
  1164.         Counter:=Value and $3F;
  1165.         Value:=ReadByte(f);
  1166.         for x:=1 to Counter do begin
  1167.           Mem[seg(p^):ofs(p^)+Offset]:=Value;
  1168.           inc(Offset); dec(xx);
  1169.         end;
  1170.       end else begin
  1171.         Mem[seg(p^):ofs(p^)+Offset]:=Value;
  1172.         inc(Offset); dec(xx);
  1173.       end;
  1174.     until xx<=0;
  1175.     inc(Offset,320-bh.MaxX-1);
  1176.   end;
  1177.   CloseFile(f);
  1178.   LoadPCX:=p;
  1179. end;
  1180.  
  1181. { Special functions }
  1182.  
  1183. Procedure MovePicToXMS(PalPtr:pointer; var PicPtr:Pointer; var Handle:word);
  1184. begin
  1185.   AllocXMS(Handle,64);
  1186.   CopyToXMS(PalPtr^,Handle,0,768);
  1187.   CopyToXMS(PicPtr^,Handle,768,64000);
  1188.   Free(PicPtr);
  1189.   PicPtr:=nil;
  1190. end;
  1191.  
  1192. Procedure CopyPicToXMS(PalPtr,PicPtr:Pointer; var Handle:word);
  1193. begin
  1194.   AllocXMS(Handle,64);
  1195.   CopyToXMS(PalPtr^,Handle,0,768);
  1196.   CopyToXMS(PicPtr^,Handle,768,64000);
  1197. end;
  1198.  
  1199. Procedure CopyPicFromXMS(PalPtr:pointer; var PicPtr:Pointer; var Handle:word);
  1200. begin
  1201.   CopyFromXMS(Handle,0,PalPtr^,768);
  1202.   if PicPtr=nil then begin
  1203.     PicPtr:=malloc(64000);
  1204.   end;
  1205.   CopyFromXMS(Handle,768,PicPtr^,64000);
  1206. end;
  1207.  
  1208. Procedure MovePicFromXMS(PalPtr:pointer; var PicPtr:Pointer; var Handle:word);
  1209. begin
  1210.   CopyFromXMS(Handle,0,PalPtr^,768);
  1211.   if PicPtr=nil then begin
  1212.     PicPtr:=malloc(64000);
  1213.   end;
  1214.   CopyFromXMS(Handle,768,PicPtr^,64000);
  1215.   FreeXMS(Handle);
  1216. end;
  1217.  
  1218. Begin
  1219. End.
  1220.